VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "X_gui"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Const BDR_RAISEDOUTER = &H1
Private Const BDR_SUNKENOUTER = &H2
Private Const BDR_RAISEDINNER = &H4
Private Const BDR_SUNKENINNER = &H8
Private Const BDR_OUTER = &H3
Private Const BDR_INNER = &HC
Private Const BDR_RAISED = &H5
Private Const BDR_SUNKEN = &HA

Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)

Private Const BF_LEFT = &H1
Private Const BF_TOP = &H2
Private Const BF_RIGHT = &H4
Private Const BF_BOTTOM = &H8
Private Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
Private Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
Private Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
Private Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Private Const BF_DIAGONAL = &H10
Private Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
Private Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
Private Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
Private Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)
Private Const BF_MIDDLE = &H800    ' Fill in the middle.
Private Const BF_SOFT = &H1000     ' Use for softer buttons.
Private Const BF_ADJUST = &H2000   ' Calculate the space left over.
Private Const BF_FLAT = &H4000     ' For flat rather than 3-D borders.
Private Const BF_MONO = &H8000     ' For monochrome borders.
Rem --edge

Private Const TA_CENTER = 6         '//ExtTextout Consts
Private Const ETO_OPAQUE = 2
Private Const ETO_GRAYED = 1
Private Const ETO_CLIPPED = 4

Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Type Rect
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Type Size
        cx As Long
        cy As Long
End Type

Public OwnerForm As Form

Rem ------ Window Stuff
Private Declare Function SetWindowPos Lib "user32" (ByVal Hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As Rect) As Long
Private Declare Function DeferWindowPos Lib "user32" (ByVal hWinPosInfo As Long, ByVal Hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOMOVE = &H2


'// Form Moveing Api Calls
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal Wparam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const WM_NCLBUTTONDBLCLK = &HA3
Private Const WM_SETHOTKEY = &H32
Private Const HTCAPTION = 2

'// End of Window Stuff.

Private Declare Function PtInRect Lib "user32" (lpRect As Rect, ByVal ptx As Long, ByVal pty As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal wOptions As Long, lpRect As Rect, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As Rect) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal un1 As Long, ByVal un2 As Long) As Long
Private Declare Function GetMenu Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function DrawCaption Lib "user32" (ByVal Hwnd As Long, ByVal hdc As Long, pcRect As Rect, ByVal un As Long) As Long
Private Declare Function GetTextExtentPoint Lib "gdi32" Alias "GetTextExtentPointA" (ByVal hdc As Long, ByVal lpszString As String, ByVal cbString As Long, lpSize As Size) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal Hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As Rect, ByVal edge As Long, ByVal grfFlags As Long) As Boolean
Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long

Private m_bRGBStart(1 To 3) As Integer   '/Gradent Fill Stuff
Private m_oStartColor As OLE_COLOR
Private m_bRGBEnd(1 To 3) As Integer
Private m_oEndColor As OLE_COLOR



Private Const Button_Size = 15          '// Experiment with these.
Private Const Frame_Size = 3            '// Experiment with these.
Private Const Gradient_Finess = 100     '// Experiment with these.


Private Exit_Rect As Rect               '// The Buttons . Mabey whe could put a fourth one in for an About dialog
Private Maxi_Rect As Rect               '// By the Way does any one Know the Constants for the DrawFrameControl Cmd ??
Private Resi_Rect As Rect
Private Mini_Rect As Rect
Private Title_Rect As Rect              '//The Title_Bar Rectangle


Public Titlebar_FrameColor As Long
Public Titlebar_BarColor As Long
Public Titlebar_Txtfgcolor As Long
'Public Titlebar_Txtbkcolor As Long

Private Sub Grow()
Dim Wr As Rect
GetWindowRect Me.OwnerForm.Hwnd, Wr
X = DeferWindowPos(Xt, Me.OwnerForm.Hwnd, Me.OwnerForm.Hwnd, Wr.Left, Wr.Top, Wr.Right + 1, Wr.Bottom + 1, SWP_NOMOVE)
End Sub


Sub Gui()


Title_Rect.Left = 20                                 '// Set The Title Bars Dimensions.
Title_Rect.Top = OwnerForm.ScaleTop
Title_Rect.Right = OwnerForm.ScaleWidth
Title_Rect.Bottom = 20


OwnerForm.ScaleMode = vbPixels

Drawtitle Me.Titlebar_BarColor, OwnerForm.hdc
Dim OldP As Long
Dim Pen As Long

Pen = CreatePen(0, 3, Me.Titlebar_FrameColor)
OldP = SelectObject(OwnerForm.hdc, Pen)
Rectangle OwnerForm.hdc, Me.OwnerForm.ScaleLeft + 1, Me.OwnerForm.ScaleTop + 1, Me.OwnerForm.ScaleWidth - 1, Me.OwnerForm.ScaleHeight - 1
SelectObject OwnerForm.hdc, OldP: DeleteObject Pen

Draw_Buttons
End Sub
Private Sub Draw_Buttons()

'//**********************************************************************************************
Exit_Rect.Left = OwnerForm.ScaleWidth - Frame_Size - Button_Size
Exit_Rect.Right = Exit_Rect.Left + Button_Size
Exit_Rect.Top = Frame_Size + 1
Exit_Rect.Bottom = Exit_Rect.Top + 15
DrawFrameControl OwnerForm.hdc, Exit_Rect, 1, 8
'//***********************************// Close Button *******************************************


'//**********************************************************************************************
Maxi_Rect.Left = OwnerForm.ScaleWidth - Frame_Size - Button_Size * 2
Maxi_Rect.Right = Maxi_Rect.Left + Button_Size
Maxi_Rect.Top = Frame_Size + 1
Maxi_Rect.Bottom = Exit_Rect.Top + 15

If OwnerForm.WindowState = 2 Then
DrawFrameControl OwnerForm.hdc, Maxi_Rect, 1, 7
Else
DrawFrameControl OwnerForm.hdc, Maxi_Rect, 1, 2
End If
'//************************************'// Maximize & Restore Button *****************************





'//**********************************************************************************************
Mini_Rect.Left = OwnerForm.ScaleWidth - Frame_Size - Button_Size * 3
Mini_Rect.Right = Mini_Rect.Left + Button_Size
Mini_Rect.Top = Frame_Size + 1
Mini_Rect.Bottom = Mini_Rect.Top + 15
DrawFrameControl OwnerForm.hdc, Mini_Rect, 1, 1
'//**********************************'// minimize Button ****************************************

End Sub
Private Function Ptr(Hwnd As Long, Rect As Rect) As Boolean
Dim pnt As POINTAPI
nRet = GetCursorPos(pnt)
ScreenToClient Hwnd, pnt
If PtInRect(Rect, pnt.X, pnt.Y) <> 0 Then Ptr = True: Exit Function
Ptr = False
End Function

Private Sub Drawtitle(Color As Long, hdc As Long)
'// Do the Gradient.
Dim Tr As Rect
Dim bRGB(1 To 3) As Integer, dR(1 To 3) As Double '//   Fine tuned Gradient fill
    
    bRGB(1) = m_bRGBStart(1)
    bRGB(2) = m_bRGBStart(2)
    bRGB(3) = m_bRGBStart(3)
    dR(1) = m_bRGBEnd(1) - m_bRGBStart(1)
    dR(2) = m_bRGBEnd(2) - m_bRGBStart(2)
    dR(3) = m_bRGBEnd(3) - m_bRGBStart(3)

Xwdth = OwnerForm.Width \ Screen.TwipsPerPixelX
Increment = Xwdth \ Gradient_Finess: If Increment = 0 Then Increment = 1

For X = 1 To Xwdth Step Increment
Tr.Left = Tr.Right
Tr.Right = Tr.Left + Increment
Tr.Bottom = 20
Tr.Top = Form1.ScaleTop + 3

B = CreateSolidBrush((bRGB(3) * &H10000 + bRGB(2) * &H100& + bRGB(1)))
FillRect hdc, Tr, B
DeleteObject B

bRGB(1) = m_bRGBStart(1) + dR(1) * (Xwdth - X) / Xwdth
bRGB(2) = m_bRGBStart(2) + dR(2) * (Xwdth - X) / Xwdth
bRGB(3) = m_bRGBStart(3) + dR(3) * (Xwdth - X) / Xwdth
        
Next X
'// Do the Gradient.


'// Draw the ICON
B = CreateSolidBrush(Color)
DrawIconEx hdc, 3, 3, Form1.Icon, 15, 17, 0, B, 0
DeleteObject B
'// Draw the ICON

Printf3 OwnerForm.Caption, 3, 20, hdc, Me.Titlebar_Txtfgcolor, 0, True


'/
Tr.Left = 3
Tr.Right = Form1.ScaleWidth
Tr.Bottom = Tr.Bottom + 3
DrawEdge OwnerForm.hdc, Tr, EDGE_BUMP, BF_BOTTOM


End Sub

Sub Printf3(Txt As String, ByVal Xpos, ByVal Ypos, hdc As Long, Color As Long, bkC As Long, Trns As Boolean)
Dim R As Rect
SetTextColor hdc, Color
SetBkColor hdc, bkC
Linc = Ypos
R.Top = Xpos

For X = 1 To Len(Txt)

CharWidth = GetText_Width(Mid(Txt, X, 1))
CharHeight = GetText_Height(Mid(Txt, X, 1))
R.Left = Linc
R.Right = Linc + CharWidth
R.Bottom = R.Top + CharHeight
If Trns = False Then ExtTextOut hdc, R.Left, R.Top, ETO_OPAQUE, R, Mid(Txt, X, 1), 1, 0
If Trns = True Then ExtTextOut hdc, R.Left, R.Top, ETO_CLIPPED, R, Mid(Txt, X, 1), 1, 0
Linc = Linc + CharWidth

Next X
End Sub




Private Sub SinkCb()
DrawEdge Form1.hdc, Exit_Rect, BDR_SUNKEN, BF_RECT
End Sub
Private Sub SinkMb()
DrawEdge Form1.hdc, Maxi_Rect, BDR_SUNKEN, BF_RECT
End Sub
Private Sub Sinkmnb()
DrawEdge Form1.hdc, Mini_Rect, BDR_SUNKEN, BF_RECT
End Sub

Sub Mouse_Down()
If Ptr(OwnerForm.Hwnd, Title_Rect) = False Then Exit Sub

If Ptr(OwnerForm.Hwnd, Exit_Rect) = True Then SinkCb: Exit Sub
If Ptr(OwnerForm.Hwnd, Mini_Rect) = True Then Sinkmnb: Exit Sub
If Ptr(OwnerForm.Hwnd, Maxi_Rect) = True Then SinkMb: Exit Sub


If OwnerForm.WindowState = 0 Then ReleaseCapture: SendMessage OwnerForm.Hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0: Exit Sub

End Sub


Sub Mouse_Up()
'If Ptr(OwnerForm.Hwnd, Title_Rect) = False Then Exit Sub
If Ptr(OwnerForm.Hwnd, Exit_Rect) = True Then Unload OwnerForm: Exit Sub

If Ptr(OwnerForm.Hwnd, Maxi_Rect) = True Then
If OwnerForm.WindowState = 0 Then OwnerForm.WindowState = 2: OwnerForm.Refresh: Exit Sub
If OwnerForm.WindowState = 2 Then OwnerForm.WindowState = 0: OwnerForm.Refresh: Exit Sub
Exit Sub
End If

If Ptr(OwnerForm.Hwnd, Mini_Rect) = True Then Form1.WindowState = 1
Draw_Buttons

End Sub


Private Sub StartColor(ByVal oColor As OLE_COLOR)
Dim lColor As Long
    If (m_oStartColor <> oColor) Then
        m_oStartColor = oColor
        OleTranslateColor oColor, 0, lColor
        m_bRGBStart(1) = lColor And &HFF&
        m_bRGBStart(2) = ((lColor And &HFF00&) \ &H100)
        m_bRGBStart(3) = ((lColor And &HFF0000) \ &H10000)
    End If
    
End Sub

Private Sub EndColor(ByVal oColor As OLE_COLOR)
Dim lColor As Long
    If (m_oEndColor <> oColor) Then
        m_oEndColor = oColor
        OleTranslateColor oColor, 0, lColor
        m_bRGBEnd(1) = lColor And &HFF&
        m_bRGBEnd(2) = ((lColor And &HFF00&) \ &H100)
        m_bRGBEnd(3) = ((lColor And &HFF0000) \ &H10000)
    End If
End Sub

Private Sub Class_Initialize()

'Ill Put more support for these l8tr
'like make them propertys or something
StartColor vbBlack
EndColor vbCyan

End Sub
Private Function GetText_Width(Txt As String) As Long
Dim S As Size
X = GetTextExtentPoint(Form1.hdc, Txt, 1, S)
GetText_Width = S.cx
End Function
Private Function GetText_Height(Txt As String) As Long
Dim S As Size
X = GetTextExtentPoint(Form1.hdc, Txt, 1, S)
GetText_Height = S.cy
End Function

